Ошибка 1004 при использовании PasteSpecial с Transpose

Question

У меня проблема с макросом, который я написал (см. Ниже). В основном, он выполняет сортировку данных, копирует их на новый лист и выполняет несколько операций с данными, таких как удаление столбцов и перенос частей данных. Наконец, он сохраняет измененные данные в .txt-файлы и продолжает цикл.

Когда я запускаю код шаг за шагом в редакторе VBA, используя F8, он обычно идет хорошо. Однако, когда я запускаю код из меню «Макросы», я всегда получаю «ошибку 1004» в части кода, упомянутого в списке ниже. Я попытался следующие, чтобы решить вопрос:

• Назначьте код кнопки вместо запуска из меню «Макросы» -> нет успеха
• получить идеи от соответствующих должностей на StackOverflow -> нет успеха
• перефразировать S.Range("G1").PasteSpecial _ заявление как S.Range(Cells(X,Y)).PasteSpecial _ -> без успеха

я упускаю что-то? Или есть более простой способ переноса данных, чем с помощью функции PasteSpecial? Я благодарен за любые советы по улучшению кода.

Вот мой код до сих пор (не говоря уже о немецких аннотаций):

Option Explicit 
Sub Speicherskript_txt() 

'Dimensionen 
Dim FileName As String 
Dim Msg As String 
Dim Path As String 
Dim dialog As FileDialog 
Dim lastrow_all As Long 
Dim lastcol_all As Long 
Dim lastrow_c As Long 
Dim lastrow_s As Long 
Dim j As Integer 
Dim Z As Integer 
Dim x As String 
Dim S As Worksheet 
Dim IP As Worksheet 
Dim C As Worksheet 

'Debug-Feature: 
On Error GoTo Errorcatch 

'Definitionen & Auswahl des Ausgabeverzeichnisses 
MsgBox "Morgä!" & vbNewLine & "Ausgabeverzeichnis für TXT-Dateien wählen. Merci." 
Set dialog = Application.FileDialog(msoFileDialogFolderPicker) 
dialog.AllowMultiSelect = False 
If dialog.Show = -1 Then 

    Path = dialog.SelectedItems(1) & "\" 'vom User gewähltes Ausgabeverzeichnis 
    lastrow_all = Cells(Rows.Count, 1).End(xlUp).Row 'Definiert letzte Zeile mit Eintrag 
    lastcol_all = Cells(1, Columns.Count).End(xlToLeft).Column 'Definiert letzte Spalte mit Eintrag 
    Set S = Worksheets("speicherblatt") 
    Set IP = Worksheets("inputs") 
    Set C = Worksheets("code") 


    'Vorgängiges Sortieren, sodass die Datenreihenfolge immer stimmt. 
    IP.Range(IP.Cells(1, 1), IP.Cells(lastrow_all, lastcol_all)).Sort _ 
     Key1:=IP.Range(IP.Cells(2, 3), IP.Cells(lastrow_all, lastcol_all)), Order1:=xlAscending, _ 
     MatchCase:=False, Orientation:=xlSortColumns, Header:=xlYes 
    IP.Range(IP.Cells(1, 1), IP.Cells(lastrow_all, lastcol_all)).Sort _ 
     Key1:=IP.Range(IP.Cells(2, 9), IP.Cells(lastrow_all, lastcol_all)), Order1:=xlAscending, _ 
     MatchCase:=False, Orientation:=xlSortColumns, Header:=xlYes 


    'Loop-Vorbereitungen 
    IP.Range("I1:I" & lastrow_all).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=C.Range("A1"), Unique:=True 
    lastrow_c = C.Cells(Rows.Count, "A").End(xlUp).Row 
    Z = lastrow_c - 1 

    'Pop-up Abfragen von Excel unterbinden 
    Application.DisplayAlerts = False 


    'LOOOOOOP zum Schreiben der Einzeldateien 
    For j = 1 To Z 
     x = C.Cells(j + 1, "A").Value 'Filterkondition pro Loop 
      'Filtern und kopieren: 
      IP.Cells(2, 1).CurrentRegion.AutoFilter 
      IP.Cells(2, 1).CurrentRegion.AutoFilter 9, x 'Filtert die neunte Spalte (Spalte "I") nach dem gesuchten String x 
      IP.Cells(2, 1).CurrentRegion.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Copy S.Cells(1, 1) 'Kopiert die gefilterten Zeilen und fügt sie ins Tabellenblatt "speicherblatt" ein. 
      IP.Cells(2, 1).CurrentRegion.AutoFilter 
      'Kopierte Daten bearbeiten (für Ausgabe als TXT-Datei): 
      S.Range("A:K").EntireColumn.Delete 'Löscht die unnötigen Spalten 
      lastrow_s = S.Cells(Rows.Count, 1).End(xlUp).Row 'Definiert die letzte gefüllte Zeile vom Speicherblatt 
      'Transponierfunktionen in zwei Schritten (1. Schritt: Zeitspalte, 2. Schritt: HQ-Werte) 
      S.Range(Cells(1, 1), Cells(1, 3)).Copy 
      S.Range("G1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, Transpose:=True 
      S.Range("A:C").EntireColumn.Delete 
      S.Range(Cells(1, 1), Cells(lastrow_s, 3)).Copy 
      S.Range("E1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, Transpose:=True 
      S.Range("A:C").EntireColumn.Delete 'Löscht alle unnötigen Spalten. 
      'Dateien schreiben: 
      FileName = x & ".txt" 'Ausgabefile wird nach jeweiligem Hierarchiecode benannt 
      S.SaveAs Path & FileName, xlTextWindows 'Speichert als Windows TXT 
      S.Cells.Clear 'Löscht die übertragenen Werte nach dem Speichern wieder. 
    Next j 

    'Pop-up Abfragen von Excel wieder erlauben 
    Application.DisplayAlerts = True 

End If 

    MsgBox "Finito Lavoro!" & vbNewLine & "Die Ausgabedateien befinden sich im Ordner: " & Path & vbNewLine & "Excel wird nun geschlossen." 

    ActiveWorkbook.Saved = True 
    Application.Quit 

Exit Sub 


Errorcatch: 
    If Err.Number <> 0 Then 
     Msg = "Error #" & Str(Err.Number) & " was generated by " & Err.Source & Chr(13) & "Error Line: " & Chr(13) & Err.Description 
     MsgBox Msg 
    End If 


End Sub 

Answer 1

а) Вполне возможно, что Range.Cells property в S.Range(Cells(1, 1), Cells(1, 3)).Copy не знают, что они должны принадлежать к S. В идеале больше похоже,

S.Range(S.Cells(1, 1), S.Cells(1, 3)).Copy 
S.Range("G1").PasteSpecial Paste:=xlPasteValues, Transpose:=True 
'or 
With S 
    .Range(.Cells(1, 1), .Cells(1, 3)).Copy 
    .Range("G1").PasteSpecial Paste:=xlPasteValues, Transpose:=True 
    'alternate 
    .Range("G1").Resize(3, 1) = _ 
     Application.Transpose(.Range("A1").Resize(1, 3).Value) 
End With. 

б) Передача значения непосредственной может быть перенесена с помощью объекта приложения Transpose function.

With S 
    .Range("E1").Resize(3, lastrow_s) = _ 
     Application.Transpose(.Range("A1").Resize(lastrow_s, 3).Value) 
End With